Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/ddlnch10/ddlnch.frm

Visual Basic Form | 1995-05-08 | 13.6 KB | 376 lines

VERSION 2.00
Begin Form ddlnch
   Caption         =   "Drag Drop Launch"
   ClientHeight    =   4380
   ClientLeft      =   2595
   ClientTop       =   2385
   ClientWidth     =   4470
   Height          =   4785
   Icon            =   DDLNCH.FRX:0000
   Left            =   2535
   LinkTopic       =   "Form1"
   ScaleHeight     =   4380
   ScaleWidth      =   4470
   Top             =   2040
   Width           =   4590
   Begin CommandButton AboutButton
      Caption         =   "About"
      Height          =   492
      Left            =   2760
      TabIndex        =   4
      Top             =   3240
      Width           =   852
   End
   Begin CommonDialog CMDialog1
      FontBold        =   -1  'True
      Left            =   2880
      Top             =   3960
   End
   Begin CommandButton ExitButton
      Caption         =   "Exit"
      Height          =   492
      Left            =   2760
      TabIndex        =   3
      Top             =   2520
      Width           =   852
   End
   Begin CommandButton DoneButton
      Caption         =   "Done"
      Height          =   492
      Left            =   2760
      TabIndex        =   2
      Top             =   1800
      Width           =   852
   End
   Begin ListBox List1
      Height          =   2370
      Left            =   600
      TabIndex        =   0
      Top             =   1560
      Width           =   1935
   End
   Begin Label Label1
      Caption         =   "The INI file did not contain the section you specified on the command line.  The following things are in the INI file.  Please select one of them, or EXIT to quit."
      Height          =   1332
      Left            =   600
      TabIndex        =   1
      Top             =   240
      Width           =   3252
   End
Dim PartialCmds(5) As String
Dim FilePointer As Integer
Dim DirPointer As Integer
Dim DirMask As String
Sub AboutButton_Click ()
    lf$ = Chr$(10)
    MsgBox "Version " + VERSION + lf$ + " Written by Robert Castle CIS 70337,605" + lf$ + "Free Use to All", MB_OK, "Drag Drop Launcher"
End Sub
Sub DDWhatAmI (DDName, DDCmdString, FilePointer, DirPointer, PartialCmds() As String, DirMask, ChgDirFlag)
Dim TempString As String, TempString1 As String
Dim IniPathFile As String
Dim StringLen As Integer
Dim x As Integer, i As Integer, NumItems As Integer
Dim DirMarkerStart As Integer, DirmaarkerEnd As Integer
Dim FileMarkerStart As Integer, FileMarkerEnd As Integer
Dim LDDCmdString As Integer, LDirMask As Integer
'get from the ini file, what I am supposed to do.
IniPathFile = CurDir$ + "\" + INIFILE       'try current dir
NumItems = GetPrivateProfileInt("Main", "Number", 0, IniPathFile)
If NumItems = 0 Then
    IniPathFile = INIFILE   'let windows try the Windows Dir
    NumItems = GetPrivateProfileInt("Main", "Number", 0, IniPathFile)
    If NumItems = 0 Then
        MsgBox "INI file is invalid or missing", MB_OK, "DDLnch"
        End
    End If
End If
If DDName = "" Then
    'parse the command string
    '
    TempString = Command$
    TempString = DDName
End If
If TempString = "" Then
    'nothing on command string, bring up form
    'make up list box, then exit, form load will take it
    For i = 1 To NumItems
        TempString1 = "Item" + Trim$(Str$(i))
        TempString = Space$(15)
        StringLen = 15
        x = GetPrivateProfileString("Main", TempString1, "", TempString, StringLen, IniPathFile)
        DDLNCH.List1.AddItem Left$(TempString, x)
    Next
    DDName = ""     'this so the form load procedure will know what to do
    Exit Sub
End If
DDName = Trim$(TempString)
TempString = Space$(129)
StringLen = 128
LDDCmdString = GetPrivateProfileString(DDName, "CmdString", " ", TempString, StringLen, IniPathFile)
If LDDCmdString <> 0 Then
    DDCmdString = Left$(TempString, LDDCmdString)
    '
    'nothing found, complain and exit
    '
    MsgBox "Command Line not Found under " + DDName + " in " + IniPathFile, MB_OK, DDName
    End
End If
TempString = Space$(2)
StringLen = 2
x = GetPrivateProfileString(DDName, "ChgDir", "N", TempString, StringLen, IniPathFile)
If x <> 0 Then
    If UCase$(Left$(TempString, 1)) = "Y" Then
        ChgDirFlag = True
    Else
        ChgDirFlag = False
    End If
End If
'parse the command string.
'I will parse, and set two pointers up as well as an array of strings.
'the FilePointer will either be 2,3, or 4, depending on where the file
'names should be inserted in the command string.
'the DirPointer will likewise be either 2,3,4 depending on where the destination
'file is to be inserted.
'The array of PartialCmds will be filled in with data from the command string
FileMarkerStart = InStr(1, DDCmdString, FileMarker)
FileMarkerEnd = FileMarkerStart + LENFILEMARKER      'FIRST Char AFTER <F>
DirMarkerStart = InStr(1, DDCmdString, DIRMARKER1)
'note that BOTH dirmarkerEnds may be larger than the length of the string
Debug.Print "FMStart= "; FileMarkerStart; " FMEnd= "; FileMarkerEnd; " DMStart="; DirMarkerStart
If DirMarkerStart <> 0 Then
    DirMarkerEnd = InStr(DirMarkerStart, DDCmdString, DIRMARKER2) + 1'first AFTER <Dxxxxx>
    LDirMask = DirMarkerEnd - DirMarkerStart - LENDIRMARKER1 - LENDIRMARKER2
    Debug.Print " DMEnd = "; DirMarkerEnd
    x = DirMarkerStart + LENDIRMARKER1      'point to start of dirmask
    If DirMarkerEnd = 1 Then                'marker not found
        DirMarkerStart = 0                  'invalid
    ElseIf x >= DirMarkerEnd - 1 Then
        DirMask = "*.*"                     'null length, null dirmask
    ElseIf DirMarkerEnd > x + 2 Then
        DirMask = Mid$(DDCmdString, x, DirMarkerEnd - x - 1)
        If InStr(1, DirMask, ".") = 0 Then
            DirMask = "*.*"
        End If
    Else
        DirMarkerStart = 0                  'something else invalid
    End If
End If
If DirMarkerStart = 0 Then
    x = FileMarkerStart - 1
ElseIf FileMarkerStart = 0 Then
    x = DirMarkerStart - 1
ElseIf DirMarkerStart > FileMarkerStart Then
    x = FileMarkerStart - 1
    x = DirMarkerStart - 1
End If
If x < 1 Then x = LDDCmdString
PartialCmds(1) = Left$(DDCmdString, x)   'first is always the same
If DirMarkerStart = 0 Then      'only a file marker
    If Len(DDCmdString) >= FileMarkerEnd Then
        PartialCmds(3) = Right$(DDCmdString, LDDCmdString - FileMarkerEnd + 1)
    End If
    FilePointer = 2
ElseIf FileMarkerStart = 0 Then
    'only a destination, at most. put files at end
    If Len(DDCmdString) >= DirMarkerEnd Then
        PartialCmds(3) = Right$(DDCmdString, LDDCmdString - DirMarkerEnd + 1)
        FilePointer = 4
    Else
        FilePointer = 3
    End If
    DirPointer = 2
Else                'both file and dir are present
    If FileMarkerEnd < DirMarkerStart Then
        FilePointer = 2 'file entry is first
        If DirMarkerStart > FileMarkerEnd Then
            PartialCmds(3) = Mid$(DDCmdString, FileMarkerEnd, DirMarkerStart - FileMarkerEnd)
            DirPointer = 4
        Else
            DirPointer = 3
        End If
        If Len(DDCmdString) >= DirMarkerEnd Then
            PartialCmds(5) = Right$(DDCmdString, LDDCmdString - DirMarkerEnd + 1)
        End If
    Else
        DirPointer = 2    'dir entry is first
        If FileMarkerStart >= DirMarkerEnd Then
            PartialCmds(3) = Mid$(DDCmdString, DirMarkerEnd, FileMarkerStart - DirMarkerEnd)
            FilePointer = 4
        Else
            FilePointer = 3
        End If
        If Len(DDCmdString) >= FileMarkerEnd Then
            PartialCmds(5) = Right$(DDCmdString, LDDCmdString - FileMarkerEnd + 1)
        End If
    End If
End If
For x = 1 To 5
Debug.Print "Part "; x; " = "; PartialCmds(x)
Debug.Print "FPointer="; FilePointer; " DirPointer="; DirPointer
End Sub
Sub DoneButton_Click ()
    If List1.ListIndex > -1 Then
        DDName = List1.List(List1.ListIndex)
        Form_Load
    End If
End Sub
Sub ExitButton_Click ()
    End
End Sub
Function FileSelect (DirMask As String, FilePath As String) As String
'put up commondialog and get file name
Dim x As Integer
Dim TempString As String
'x = InStr(1, DirMask, ".")
'If x <> 0 Then          'strip all but last
'    TempString = Right$(DirMask, Len(DirMask) - x)
'Else
'    TempString = DirMask
'End If
'If Len(TempString) > 0 And Len(TempString) < 4 Then
    'CMDialog1.DefaultExt = TempString
'End If
CMDialog1.DialogTitle = DDName
CMDialog1.Flags = MYFLAGSET      'equal to &H8804&
If FilePath <> "" Then
    CMDialog1.InitDir = FilePath
    CMDialog1.InitDir = CurDir$
End If
CMDialog1.Filename = ""
CMDialog1.Filter = DirMask + "|" + DirMask
CMDialog1.Action = DLG_FILE_SAVE
FileSelect = CMDialog1.Filename
End Function
Sub Form_Load ()
Dim wRemoveMsg As Integer
Dim x As Integer, i As Integer, StringLen As Integer
Dim Handle As Integer
Dim NewMessage As Msg
Dim NameOfFile As String * 129
Dim ShortFileName As String
Dim FileList As String, TempString As String
Dim TotFiles As Integer
Dim NewDir As String
Dim ChgDirFlag
ReDim ErrorMessage(31) As String
TotFiles = 0
Const PM_NOREMOVE = 0
Const PM_NOYIELD = 2
'set up error message strings
ErrorMessage(0) = "Out of Memory"
ErrorMessage(1) = ""
ErrorMessage(2) = "File not found"
ErrorMessage(3) = "Path not found"
ErrorMessage(4) = ""
ErrorMessage(5) = "Attempt to dynamically link to a task"
ErrorMessage(6) = "Library requires separate data segments for each task"
ErrorMessage(7) = ""
ErrorMessage(8) = "Insufficient Memory"
ErrorMessage(9) = ""
ErrorMessage(10) = "Incorrect Windows version"
ErrorMessage(11) = "Invalid EXE file"
ErrorMessage(12) = "O/S 2 App"
ErrorMessage(13) = "DOS 4.0 App"
ErrorMessage(14) = "Unknown .EXE Type"
ErrorMessage(15) = ".EXE created for earlier version of Windows"
ErrorMessage(16) = "Attempt to load 2nd instance (mult data segments)"
ErrorMessage(17) = "Attempt to load 2nd instance (nonshareable DLLs)"
ErrorMessage(18) = "Protected mode app in real mode"
ErrorMessage(19) = "Attempt to load compressed EXE"
ErrorMessage(20) = "DLL required for this app is invalid"
ErrorMessage(21) = "Requires 32 bit extensions"
ErrorMessage(22) = " "
ErrorMessage(23) = " "
ErrorMessage(24) = " "
ErrorMessage(25) = " "
ErrorMessage(26) = " "
ErrorMessage(27) = " "
ErrorMessage(28) = " "
ErrorMessage(29) = " "
ErrorMessage(30) = " "
ErrorMessage(31) = " "
'get what I'm supposed to do as a result of a DD event
WindowState = MINIMIZED
DDWhatAmI DDName, DDCmdString, FilePointer, DirPointer, PartialCmds(), DirMask, ChgDirFlag
If DDName = "" Then
    WindowState = NORMAL
    Exit Sub
End If
DDLNCH.Visible = True
DDLNCH.Caption = "DD-" + DDName
wRemoveMsg = PM_NOREMOVE Or PM_NOYIELD   'parameters for PeekMessage call
Handle = DDLNCH.hWnd
DragAcceptFiles Handle, True    'identify form as able to accept d/d messages
Do While DoEvents()
    'Dummy = DoEvents()
    x = PeekMessage(NewMessage, Handle, 563, 563, wRemoveMsg) 'determine if a d/d message is waiting
    If x <> 0 Then  'if a dd message is waiting
            'calling DragQueryFile with a -1 value for FileNum returns # of files dropped
        FileNum = -1
        FileList = ""                 'Clear from last call
        x = DragQueryFile(NewMessage.wparam, FileNum, NameOfFile, 128)
            For FileNum = 0 To x - 1   ' for each file dropped
                    'calling with a value greater than -1 returns name of corresponding file
                StringLen = DragQueryFile(NewMessage.wparam, FileNum, NameOfFile, 128)
                    'add NameOfFile to List
                ShortFileName = Left$(NameOfFile, StringLen)
                If ChgDirFlag Then
                    StripandFind ShortFileName, NewDir
                End If
                TempString = FileList
                If FileNum = x - 1 Then 'last file or only one
                    Spacer$ = ""
                Else
                    Spacer$ = " "
                End If
                FileList = TempString + ShortFileName + Spacer$
            Next       'get next file
        DragFinish NewMessage.wparam
        'now build command string and send
        PartialCmds(FilePointer) = FileList
        If DirPointer <> 0 Then       'if command line needs a destination file prompt
            TempString = FileSelect(DirMask, NewDir)
            If TempString = "" Then         'user didn't select anything
                GoTo LoopON
            Else
                PartialCmds(DirPointer) = TempString
            End If
        End If
        TempString = PartialCmds(1) + PartialCmds(2) + PartialCmds(3) + PartialCmds(4) + PartialCmds(5)
        Debug.Print TempString
        If ChgDirFlag Then
            ChDir NewDir
        End If
        If Len(TempString) > 128 Then
            MsgBox "Command Line TOO Long. Can't do This.", MB_OK, "DDLnch Message"
        Else
            x = WinExec(TempString, 1)
            If x < 32 Then
                MsgBox "Error Occurred - " + ErrorMessage(x), MB_OK, "DDLnch Error"
            End If
        End If
    End If
LoopON:
End Sub
Sub List1_DblClick ()
    DoneButton_Click
End Sub
Sub StripandFind (NameOfFile, PathName)
'strip the file name to base name and put the path in
'the PathName variable
Dim x, Last_x, Length As Integer
Dim TempStringg As String
Length = Len(NameOfFile)
If Mid$(NameOfFile, 2, 1) = ":" Then
    x = 3
    x = 1
End If
Do While x <> 0
    Last_x = x
    x = InStr(Last_x + 1, NameOfFile, "\")
PathName = Left$(NameOfFile, Last_x - 1)
TempStringg = Right$(NameOfFile, Length - Last_x)
NameOfFile = TempStringg
Debug.Print NameOfFile; PathName
End Sub